home *** CD-ROM | disk | FTP | other *** search
/ The Fatted Calf / The Fatted Calf.iso / Demos / ByCompany / ActiveIngredients / communicae / communicae.app / DemoFiles / communicae-mouse.el < prev    next >
Lisp/Scheme  |  1993-09-21  |  3KB  |  100 lines
  1. ;;    communicae-mouse.el
  2. ;;    Active Ingredients, Inc.  1990
  3.  
  4. ;; Allow the Command+key combinations to work:
  5. (setq meta-flag t)
  6.  
  7. ;; Make mouse clicks in Communicae move the point to the cursor.
  8. ;; "send mouse clicks" must also be turned on in the Emulation panel.
  9. ;;
  10. ;; This version is very simple.  It would be nice to make double/triple
  11. ;; clicks and drags select regions, and shift flags do cut/paste.  It
  12. ;; may also be nice to make clicks in completion lists copy the word
  13. ;; into the minibuffer.  If you would like to make such
  14. ;; changes, the args are:
  15. ;;
  16. ;;    (nth 0 args) - screen row (starting at 1)
  17. ;;    (nth 1 args) - screen column (starting at 1)
  18. ;;    (nth 2 args) - bit flags:
  19. ;;        0xF - 0 = drag, 1 = single click, 2 = double, etc.
  20. ;;        16 - Alpha lock or Shift
  21. ;;        32 - Shift
  22. ;;        64 - Control
  23. ;;        128 - Alternate
  24. ;;        256 - Command
  25.  
  26. (defun screen-pos-to-window (x y)
  27.   "Find window corresponding to screen coordinates.
  28. X and Y are 0-based character positions on the screen."
  29.   (let ((edges (window-edges))
  30.     (window nil))
  31.     (while (and (not (eq window (selected-window)))
  32.         (or (<  y (nth 1 edges))
  33.             (>= y (nth 3 edges))
  34.             (<  x (nth 0 edges))
  35.             (>= x (nth 2 edges))))
  36.       (setq window (next-window window))
  37.       (setq edges (window-edges window))
  38.       )
  39.     (or window (selected-window))
  40.     )
  41.   )
  42.  
  43. (defun mouse-handle (args)
  44.   "Handles Communicae mouse press"
  45.   (let*
  46.       ((y (- (nth 0 args) 1))
  47.        (x (- (nth 1 args) 1))
  48.        window edges)
  49.     (if (eq (logand (nth 2 args) 15) 0)
  50.     (setq window (selected-window))
  51.       (setq window (screen-pos-to-window x y))
  52.       (select-window window))
  53.     (setq edges (window-edges window))
  54.     (setq x (- x (nth 0 edges)))
  55.     (setq y (- y (nth 1 edges)))
  56.     (cond ((>= y (- (nth 3 edges) (nth 1 edges) 1))
  57.        (scroll-up 1)
  58.        (move-to-window-line -1))
  59.       ((>= y 0)
  60.        (move-to-window-line y))
  61.       (t (scroll-down 1) (move-to-window-line 0)))
  62.     (move-to-column x)
  63.     ))
  64.  
  65. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  66. ;; This code makes Emacs parse the ^[[ sequences produced by ANSI
  67. ;; terminals, and then do something intelligent based on the last
  68. ;; character.  Currently it recognizes the H for the mouse clicks,
  69. ;; and inserts all other characters.
  70. ;; If send-8-bits is turned on, a M-^[ is sent (not a M-[ as you
  71. ;; might expect).  This conflicts with the eval command.  It also
  72. ;; means that M-[ does eval, but M-[ does nothing by default.
  73.  
  74. (defun read-arg-list ()
  75.   "Read a #;#;#X list as produced by ANSI terminals.  Returns the list
  76. of numbers and the terminating character."
  77.   (let*
  78.       ((args (list 0)) (char (read-char)))
  79.     (while (< char ?@)
  80.       (if (and (>= char ?0) (<= char ?9))
  81.       (rplaca args (+ (* (car args) 10) (- char ?0))))
  82.       (if (eq char ?\;) (setq args (cons 0 args)))
  83.       (setq char (read-char))
  84.       )
  85.     (cons (nreverse args) char)))
  86.  
  87. (defun csi-handle ()
  88.   "Handles terminal ^[[ sequences, does eval-expression if you type Esc-Esc"
  89.   (interactive)
  90.   (if (input-pending-p)
  91.       (let*
  92.       ((args (read-arg-list)) (code (cdr args)) (args (car args)))
  93.     (cond
  94.      ((= code ?H) (mouse-handle args))
  95.      (t (insert-char code 1))))
  96.     (command-execute 'eval-expression)))
  97.  
  98. (global-set-key "\M-[" 'csi-handle)
  99. (global-set-key "\233" 'csi-handle)
  100.